home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / objdoc.txi < prev    next >
Text File  |  1999-04-19  |  8KB  |  239 lines
  1.  
  2. @code{(require 'object)}
  3. @ftindex object
  4.  
  5. This is the Macroless Object System written by Wade Humeniuk
  6. (whumeniu@@datap.ca).  Conceptual Tributes: @ref{Yasos}, MacScheme's
  7. %object, CLOS, Lack of R4RS macros.
  8.  
  9. @subsection Concepts
  10. @table @asis
  11.  
  12. @item OBJECT
  13. An object is an ordered association-list (by @code{eq?}) of methods
  14. (procedures).  Methods can be added (@code{make-method!}), deleted
  15. (@code{unmake-method!}) and retrieved (@code{get-method}).  Objects may
  16. inherit methods from other objects.  The object binds to the environment
  17. it was created in, allowing closures to be used to hide private
  18. procedures and data.
  19.  
  20. @item GENERIC-METHOD
  21. A generic-method associates (in terms of @code{eq?}) object's method.
  22. This allows scheme function style to be used for objects.  The calling
  23. scheme for using a generic method is @code{(generic-method object param1
  24. param2 ...)}.
  25.  
  26. @item METHOD
  27. A method is a procedure that exists in the object.  To use a method
  28. get-method must be called to look-up the method.  Generic methods
  29. implement the get-method functionality.  Methods may be added to an
  30. object associated with any scheme obj in terms of eq?
  31.  
  32. @item GENERIC-PREDICATE
  33. A generic method that returns a boolean value for any scheme obj.
  34.  
  35. @item PREDICATE
  36. A object's method asscociated with a generic-predicate. Returns
  37. @code{#t}.
  38. @end table
  39.  
  40. @subsection Procedures
  41.  
  42. @defun make-object ancestor @dots{}
  43. Returns an object.  Current object implementation is a tagged vector.
  44. @var{ancestor}s are optional and must be objects in terms of object?.
  45. @var{ancestor}s methods are included in the object.  Multiple
  46. @var{ancestor}s might associate the same generic-method with a method.
  47. In this case the method of the @var{ancestor} first appearing in the
  48. list is the one returned by @code{get-method}.
  49. @end defun
  50.  
  51. @defun object? obj
  52. Returns boolean value whether @var{obj} was created by make-object.
  53. @end defun
  54.  
  55. @defun make-generic-method exception-procedure
  56. Returns a procedure which be associated with an object's methods.  If
  57. @var{exception-procedure} is specified then it is used to process
  58. non-objects.
  59. @end defun
  60.  
  61. @defun make-generic-predicate
  62. Returns a boolean procedure for any scheme object.
  63. @end defun
  64.  
  65. @defun make-method! object generic-method method
  66. Associates @var{method} to the @var{generic-method} in the object.  The
  67. @var{method} overrides any previous association with the
  68. @var{generic-method} within the object.  Using @code{unmake-method!}
  69. will restore the object's previous association with the
  70. @var{generic-method}.  @var{method} must be a procedure.
  71. @end defun
  72.  
  73. @defun make-predicate! object generic-preciate
  74. Makes a predicate method associated with the @var{generic-predicate}.
  75. @end defun
  76.  
  77. @defun unmake-method! object generic-method
  78. Removes an object's association with a @var{generic-method} .
  79. @end defun
  80.  
  81. @defun get-method object generic-method
  82. Returns the object's method associated (if any) with the
  83. @var{generic-method}.  If no associated method exists an error is
  84. flagged.
  85. @end defun
  86.  
  87. @subsection Examples
  88.  
  89. @example
  90. (require 'object)
  91. @ftindex object
  92.  
  93. (define instantiate (make-generic-method))
  94.  
  95. (define (make-instance-object . ancestors)
  96.   (define self (apply make-object
  97.                       (map (lambda (obj) (instantiate obj)) ancestors)))
  98.   (make-method! self instantiate (lambda (self) self))
  99.   self)
  100.  
  101. (define who (make-generic-method))
  102. (define imigrate! (make-generic-method))
  103. (define emigrate! (make-generic-method))
  104. (define describe (make-generic-method))
  105. (define name (make-generic-method))
  106. (define address (make-generic-method))
  107. (define members (make-generic-method))
  108.  
  109. (define society
  110.   (let ()
  111.     (define self (make-instance-object))
  112.     (define population '())
  113.     (make-method! self imigrate!
  114.                   (lambda (new-person)
  115.                     (if (not (eq? new-person self))
  116.                         (set! population (cons new-person population)))))
  117.     (make-method! self emigrate!
  118.                   (lambda (person)
  119.                     (if (not (eq? person self))
  120.                         (set! population
  121.                               (comlist:remove-if (lambda (member)
  122.                                                    (eq? member person))
  123.                                                  population)))))
  124.     (make-method! self describe
  125.                   (lambda (self)
  126.                     (map (lambda (person) (describe person)) population)))
  127.     (make-method! self who
  128.                   (lambda (self) (map (lambda (person) (name person))
  129.                                       population)))
  130.     (make-method! self members (lambda (self) population))
  131.     self))
  132.  
  133. (define (make-person %name %address)
  134.   (define self (make-instance-object society))
  135.   (make-method! self name (lambda (self) %name))
  136.   (make-method! self address (lambda (self) %address))
  137.   (make-method! self who (lambda (self) (name self)))
  138.   (make-method! self instantiate
  139.                 (lambda (self)
  140.                   (make-person (string-append (name self) "-son-of")
  141.                                %address)))
  142.   (make-method! self describe
  143.                 (lambda (self) (list (name self) (address self))))
  144.   (imigrate! self)
  145.   self)
  146. @end example
  147.  
  148. @subsubsection Inverter Documentation
  149. Inheritance:
  150. @lisp
  151.         <inverter>::(<number> <description>)
  152. @end lisp
  153. Generic-methods
  154. @lisp
  155.         <inverter>::value      @result{} <number>::value
  156.         <inverter>::set-value! @result{} <number>::set-value!
  157.         <inverter>::describe   @result{} <description>::describe
  158.         <inverter>::help
  159.         <inverter>::invert
  160.         <inverter>::inverter?
  161. @end lisp
  162.  
  163. @subsubsection Number Documention
  164. Inheritance
  165. @lisp
  166.         <number>::()
  167. @end lisp
  168. Slots
  169. @lisp
  170.         <number>::<x>
  171. @end lisp
  172. Generic Methods
  173. @lisp
  174.         <number>::value
  175.         <number>::set-value!
  176. @end lisp
  177.  
  178. @subsubsection Inverter code
  179. @example
  180. (require 'object)
  181. @ftindex object
  182.  
  183. (define value (make-generic-method (lambda (val) val)))
  184. (define set-value! (make-generic-method))
  185. (define invert (make-generic-method
  186.                 (lambda (val)
  187.                   (if (number? val)
  188.                       (/ 1 val)
  189.                       (error "Method not supported:" val)))))
  190. (define noop (make-generic-method))
  191. (define inverter? (make-generic-predicate))
  192. (define describe (make-generic-method))
  193. (define help (make-generic-method))
  194.  
  195. (define (make-number x)
  196.   (define self (make-object))
  197.   (make-method! self value (lambda (this) x))
  198.   (make-method! self set-value!
  199.                 (lambda (this new-value) (set! x new-value)))
  200.   self)
  201.  
  202. (define (make-description str)
  203.   (define self (make-object))
  204.   (make-method! self describe (lambda (this) str))
  205.   (make-method! self help (lambda (this) "Help not available"))
  206.   self)
  207.  
  208. (define (make-inverter)
  209.   (let* ((self (make-object
  210.                 (make-number 1)
  211.                 (make-description "A number which can be inverted")))
  212.          (<value> (get-method self value)))
  213.     (make-method! self invert (lambda (self) (/ 1 (<value> self))))
  214.     (make-predicate! self inverter?)
  215.     (unmake-method! self help)
  216.     (make-method! self help
  217.                   (lambda (self)
  218.                     (display "Inverter Methods:") (newline)
  219.                     (display "  (value inverter) ==> n") (newline)))
  220.     self))
  221.  
  222. ;;;; Try it out
  223.  
  224. (define invert! (make-generic-method))
  225.  
  226. (define x (make-inverter))
  227.  
  228. (make-method! x invert! (lambda (x) (set-value! x (/ 1 (value x)))))
  229.  
  230. (value x)                       @result{} 1
  231. (set-value! x 33)               @result{} undefined
  232. (invert! x)                     @result{} undefined
  233. (value x)                       @result{} 1/33
  234.  
  235. (unmake-method! x invert!)      @result{} undefined
  236.  
  237. (invert! x)                     @error{}  ERROR: Method not supported: x
  238. @end example
  239.